perm filename PRESCN.OLD[NEW,LCS] blob
sn#209701 filedate 1977-12-14 generic text, type T, neo UTF8
32600 SUBROUTINE PRESCN
32700 C THIS SORTS OUT NEW INPUT FORMAT - CREATES OLD STYLE.
32740 COMMON/SCX/RHY(4),JALPHA(30),J4,L,Y,K,RX,RZ,RA,J5
32750 COMMON/SCN/LL,LR,LU,LD,LSL,LE,LC,LS,LF,LA,LI,LW
32775 DATA LL/'L'/,LR/'R'/,LU/'U'/,LD/'D'/,LE/'E'/
32787 1,LC/'C'/,LS/'S'/,LF/'F'/,LA/'A'/,LI/'I'/,LW/'W'/
32800 DIMENSION IR(1)
32900 COMMON/ALF/INP(72),M/XRN/RN(4000)
33000 EQUIVALENCE (IR,RN(2001)),(LCM,JALPHA),(LBL,JALPHA(12))
33050 1,(LST,ALPHA(8))
33100 C CHECK THIS EQUIV.↑↑↑↑
33200 100 IF(ISM)5,55,555
33300 C -1=PROCESS SOME MORE, 0=1ST TIME, 1=PUT OUT RHYTH
33350 C !!!!! DON'T STOP IN THE MIDDLE!!! ISM MUST BE 0 FIRST TIME!!!!
33400 55 JX=0
33500 5 K=0
33600 J=0
33700 I=JX
33800 JX=JX+72
33900 1 K=K+1
34000 M=INP(K)
34100 15 IF(M.EQ.LBL)GO TO 1
34150 IF(M.EQ.LCM)GO TO 1
34200 C REMOVE BLANKS AND COMMAS
34300 JN=0
34400 IF(M.LT.'0')GO TO 677
34450 IF(M.LE.'9')GO TO 2
34500 677 MM=INP(K+1)
34710 3 IF(M.EQ.'P')GO TO 8
34720 IF(M.EQ.'O')GO TO 8
34730 IF(M.LT.LA)GO TO 777
34740 IF(M.GT.'G')GO TO 777
34750 IF(MM.EQ.LL)GO TO 777
34760 IF(MM.NE.LA)GO TO 8
34800 C FINDS NOTES, PROX., AND ORDINARY, -- NOT 'BA' OR 'AL'
34900 777 IF(M.NE.LR)GO TO 9
35000 IF(MM.EQ.LE)JN=1
35100 C CATCHES 'R' 'RI' 'REP'
35200 GO TO 8
35300 9 IF(M.EQ.LSL)GO TO 8
35310 IF(M.EQ.';')GO TO 8
35320 IF(M.EQ.LST)GO TO 8
35330 IF(M.EQ.':')GO TO 8
35400 JN=-1
35500 8 J=J+1
35600 INP(J)=M
35700 IF(M.EQ.'X')JN=1
35800 C PICKS UP 4X ETC. FOR BOTH NOTES AND RHYTH.
35900 IF(JN.LE.0)GO TO 13
36000 C PUTS 'REP' INTO RHYTH ALSO
36100 I=I+1
36200 IR(I)=M
36300 13 IF(M.EQ.LSL)GO TO 4
36310 IF(M.EQ.';')GO TO 4
36320 IF(M.EQ.LST)GO TO 4
36400 K=K+1
36500 M=INP(K)
36600 GO TO 8
36700
36800 4 IF(JN.NE.0)GO TO 7
36900 I=I+1
37000 IR(I)=M
37100 7 IF(M.EQ.LSL)GO TO 1
37200 IF(M.EQ.';')GO TO 11
37300 IF(M.EQ.LST)GO TO 6
37400
37500 2 I=I+1
37600 IR(I)=M
37700 K=K+1
37800 M=INP(K)
37900 IF(M.EQ.'.')GO TO 2
37910 IF(M.LT.'0')GO TO 15
37920 IF(M.LE.'9')GO TO 2
38000 C NO BLANK NEEDED AFTER RHYTH.( /4.AS3/8/ ETC.)
38100 GO TO 15
38200
38300 11 IF(IR(I).NE.';')IR(I)=';'
38400 ISM=-1
38500 RETURN
38600 C WE'LL COME BACK FOR MORE.
38700
38800 6 IF(IR(I).NE.LST)IR(I)=LST
38900 JX=0
39000 ISM=1
39100 C AFTER THIS WE USE RHYTJ DATA.
39200 RETURN
39300
39400 555 DO 12 K=1,72
39500 M=IR(K+JX)
39600 INP(K)=M
39700 IF(M.EQ.';')GO TO 10
39800 C MORE THAN ONE LINE
39900 12 IF(M.EQ.LST)GO TO 14
40000 10 JX=JX+72
40100 C MOVE TO THE NEXT 'LINE'
40200 RETURN
40300 14 ISM=0
40400 END